Fix #156 by allowing multiple replacements

Add which-key-allow-multiple-replacements which can be set to allow multiple
replacements from which-key-replacement-alist to apply to a key binding.

Switch from using assoc-default to find replacements to
which-key--get-replacements.

Adjusts tests and add a new one for multiple replacements.

diff --git a/which-key-tests.el b/which-key-tests.el
index 93e1dfa969f157e24726eb96f0c365f54b7ed2bb..aa50ec01ae7d08aca2c3ddaf8c9d2e08bd205bee 100644 (file)
--- a/which-key-tests.el
+++ b/which-key-tests.el
@@ -51,7 +51,8 @@
          '((("C-c [a-d]" . nil) . ("C-c a" . "c-c a"))
            (("C-c .+" . nil) . ("C-c *" . "c-c *"))))
         (test-mode-1 t)
-        (test-mode-2 nil))
+        (test-mode-2 nil)
+        which-key-allow-multiple-replacements)
     (which-key-add-key-based-replacements
       "C-c ." "test ."
       "SPC ." "SPC ."
@@ -97,5 +98,21 @@
              (which-key--maybe-replace '("SPC t 2" . "test mode"))
              '("SPC t 2" . "[ ] test mode")))))
 
+(ert-deftest which-key-test--maybe-replace-multiple ()
+  "Test `which-key-allow-multiple-replacements'. See #156"
+  (let ((which-key-replacement-alist
+         '(((nil . "helm") . (nil . "HLM"))
+           ((nil . "projectile") . (nil . "PRJTL"))))
+        (which-key-allow-multiple-replacements t))
+    (should (equal
+             (which-key--maybe-replace '("C-c C-c" . "helm-x"))
+             '("C-c C-c" . "HLM-x")))
+    (should (equal
+             (which-key--maybe-replace '("C-c C-c" . "projectile-x"))
+             '("C-c C-c" . "PRJTL-x")))
+    (should (equal
+             (which-key--maybe-replace '("C-c C-c" . "helm-projectile-x"))
+             '("C-c C-c" . "HLM-PRJTL-x")))))
+
 (provide 'which-key-tests)
 ;;; which-key-tests.el ends here

diff --git a/which-key.el b/which-key.el
index c5746a3f44532f13c3f9d30232a65116464c13e7..56dad94e3c20d5fc9f84299061181180ffbd9ac1 100644 (file)
--- a/which-key.el
+++ b/which-key.el
@@ -177,7 +177,11 @@ REPLACEMENT may also be a function taking a cons cell
 \(KEY . BINDING\) and producing a new corresponding cons cell.
 
 If REPLACEMENT is anything other than a cons cell \(and non nil\)
-the key binding is ignored by which-key."
+the key binding is ignored by which-key.
+
+Finally, you can multiple replacements to occur for a given key
+binding by setting `which-key-allow-multiple-replacements' to a
+non-nil value."
   :group 'which-key
   :type '(alist :key-type (alist :key-type regexp :value-type regexp)
                 :value-type (alist :key-type regexp :value-type regexp)))
@@ -195,6 +199,14 @@ the key binding is ignored by which-key."
            which-key-replacement-alist))
    which-key-description-replacement-alist))
 
+(defcustom which-key-allow-multiple-replacements nil
+  "Allow a key binding to match and be modified by multiple
+elements in `which-key-replacement-alist' if non-nil. When nil,
+only the first match is used to perform replacements from
+`which-key-replacement-alist'."
+  :group 'which-key
+  :type 'boolean)
+
 (defcustom which-key-highlighted-command-list '()
   "A list of strings and/or cons cells used to highlight certain
 commands. If the element is a string, assume it is a regexp
@@ -1248,46 +1260,54 @@ local bindings coming first. Within these categories order using
 (defsubst which-key--butlast-string (str)
   (mapconcat #'identity (butlast (split-string str)) " "))
 
-(defun which-key--replacement-test (alist-key key)
-  "`assoc-default' test to find bindings in `which-key-replacement-alist'.
-Used in `which-key--maybe-replace'."
-  (let (case-fold-search)
-    (when (and (consp alist-key)
-               (or (null (car alist-key))
-                   (string-match-p (car alist-key) (car key)))
-               (or (null (cdr alist-key))
-                   (string-match-p (cdr alist-key) (cdr key))))
-      (setq which-key--last-replace-key alist-key))))
+(defun which-key--get-replacements (key-binding &optional use-major-mode)
+  (let ((alist (or (and use-major-mode
+                        (cdr-safe (assq major-mode which-key-replacement-alist)))
+                   which-key-replacement-alist))
+        res case-fold-search)
+    (catch 'res
+      (dolist (replacement alist)
+        ;; these are mode specific ones to ignore. The mode specific case is
+        ;; handled in the selection of alist
+        (unless (symbolp (car replacement))
+          (let ((key-regexp (caar replacement))
+                (binding-regexp (cdar replacement)))
+            (when (and (or (null key-regexp)
+                           (string-match-p key-regexp
+                                           (car key-binding)))
+                       (or (null binding-regexp)
+                           (string-match-p binding-regexp
+                                           (cdr key-binding))))
+              (push replacement res)
+              (when (not which-key-allow-multiple-replacements)
+                (throw 'res res)))))))
+    (nreverse res)))
 
 (defun which-key--maybe-replace (key-binding)
   "Use `which-key--replacement-alist' to maybe replace KEY-BINDING.
 KEY-BINDING is a cons cell of the form \(KEY . BINDING\) each of
 which are strings. KEY is of the form produced by `key-binding'."
-  (setq which-key--last-replace-key nil)
-  (let* ((mode-alist (assq major-mode which-key-replacement-alist))
-         (mode-res (when mode-alist
-                     (assoc-default
-                      key-binding mode-alist 'which-key--replacement-test)))
-         (res (or mode-res
-                  (assoc-default
-                   key-binding which-key-replacement-alist
-                   'which-key--replacement-test))))
-    (cond ((null res) key-binding)
-          ((functionp res) (funcall res key-binding))
-          ((consp res)
-           (cons
-            (cond ((and (car res) (car which-key--last-replace-key))
-                   (replace-regexp-in-string
-                    (car which-key--last-replace-key)
-                    (car res) (car key-binding) t))
-                  ((car res) (car res))
-                  (t (car key-binding)))
-            (cond ((and (cdr res) (cdr which-key--last-replace-key))
-                   (replace-regexp-in-string
-                    (cdr which-key--last-replace-key)
-                    (cdr res) (cdr key-binding) t))
-                  ((cdr res) (cdr res))
-                  (t (cdr key-binding))))))))
+  (let* ((mode-res (which-key--get-replacements key-binding t))
+         (all-repls (or mode-res
+                      (which-key--get-replacements key-binding))))
+    (dolist (repl all-repls key-binding)
+      (setq key-binding
+            (cond ((or (not (consp repl)) (null (cdr repl)))
+                   key-binding)
+                  ((functionp (cdr repl))
+                   (funcall (cdr repl) key-binding))
+                  ((consp (cdr repl))
+                   (cons
+                    (cond ((and (caar repl) (cadr repl))
+                           (replace-regexp-in-string
+                            (caar repl) (cadr repl) (car key-binding) t))
+                          ((cadr repl) (cadr repl))
+                          (t (car key-binding)))
+                    (cond ((and (cdar repl) (cddr repl))
+                           (replace-regexp-in-string
+                            (cdar repl) (cddr repl) (cdr key-binding) t))
+                          ((cddr repl) (cddr repl))
+                          (t (cdr key-binding))))))))))
 
 (defsubst which-key--current-key-list (&optional key-str)
   (append (listify-key-sequence which-key--current-prefix)